perm filename TVIOF.F4[PIC,LCS]2 blob
sn#092574 filedate 1974-02-12 generic text, type T, neo UTF8
C TVIOF NOVEMBER 9, 69 TVIOF
COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
1 DEBUG,T,XP,YP,PARMAX,
1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
COMMON /LISTC/ LIST,LIST5,NEWEND,LO
COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
1 LSIDE,RSIDE,DTA,HYSTAB
DIMENSION LIST5(0/1000),LIST(6,1000),BTLIP(0/15),
1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)
INTEGER BCLIP,TCLIP,BITS,FLINE,LLINE,
1 LSIDE,RSIDE,HYSTAB,DTA,IB,HEL,I,TIM1,TIM2,TIM4,TIM5,
1 TAPE,FILEN,NEWEND,ALFAB,YES,NO,FILE,BTLIP,LIP
REAL INT,HIG,QAL,QALOLD,NUPO,TIM3,HIL,HILOLD
LOGICAL LOAP,LOAU,PLAY,SAVU,SAVP,NOPR,NOLU,NOLP
CC LOGICAL FUNCTION ADMISS
CC ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
TAPE=1
DTA=-7
CALL TIMER(TIM1)
1 CALL INITAL
BCLIP=7
TCLIP=0
BITS=4
FLINE=20
LLINE=250
LSIDE=6
RSIDE=302
C IWID=RSIDE-LSIDE+1
C I=36/BITS
C LINLEN=(IWID+I-1)/I
C TVSZ=(LLINE-FLINE+1)*LINLEN
YES='Y'
NO ='N'
SAVU=.FALSE.
C UNPROCESSED PICTURE HAS BEEN SAVED IF SAVU.EQ..TRUE.
SAVP=.FALSE.
C PROCESSED PICTURE HAS BEEN SAVED
LOAP=.FALSE.
C PROCESSED PICTURE HAS BEEN LOADED
LOAU=.FALSE.
C UNPROCESSED PICTURE HAS BEEN LOADED
PLAY=.FALSE.
C PROGRAMS PICTURE WAS OFFERED OR OVER WRITTEN
NOPR=.FALSE.
C PROCESSING NOT WANTED
NOLU=.FALSE.
C LOADING OF UNPROCESSED NOT WANTED
NOLP=.FALSE.
C LOADING OF PROCESSED NOT WANTED
3 FORMAT(' DO YOU WANT TO TAKE A PICTURE WITH THE TV CAMERA ?'/)
TYPE 3
6 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 8
IF(ALFAB.EQ.NO ) GOTO 158
C TYPE 103
GOTO 3
8 DO 9 I=0,15
9 BTLIP(I)=7-I/2
7 FORMAT(' DO YOU WANT TO READ A FRAME
1 OTHER THAN THE MAXIMAL ?'/)
16 TYPE 7
ACCEPT 83, ALFAB
IF(ALFAB.EQ.YES) GOTO 18
IF(ALFAB.EQ.NO ) GOTO 17
CC TYPE 103
GOTO 16
18 TYPE 19
19 FORMAT(' TYPE FLINE, LLINE, LSIDE, RSIDE'/)
20 FORMAT(4I)
ACCEPT 20,FLINE,LLINE,LSIDE,RSIDE
21 FORMAT(4I4/)
TYPE 21,FLINE,LLINE,LSIDE,RSIDE
17 CALL TVIN
CALL HISTO
TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
10 FORMAT(' DO YOU WANT TO OVER WRITE AUTOMATIC CLIP
1 LEVEL SETTING ?'/)
30 TYPE 10
11 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 13
IF(ALFAB.EQ. NO) GOTO 62
CC TYPE 103
GOTO 11
12 FORMAT(' TYPE BCLIP'/)
13 TYPE 12
ACCEPT 133,BCLIP
15 FORMAT(1H+,I1/)
TYPE 15,BCLIP
14 FORMAT(' TYPE TCLIP'/)
TYPE 14
ACCEPT 133,TCLIP
TYPE 15, TCLIP
GOTO 67
62 CALL CLIPS
63 FORMAT(7H BCLIP=I2/7H TCLIP=I2//16(I7,2I4/))
66 FORMAT(' RETURN CARRIAGE FOR FINAL TV READING',$)
67 TYPE 66
ACCEPT 83,ALFAB
DO 64 I=0,15
HILOLD=HIL
HIL=(1.0-(FLOAT(I)-0.5)/14.0)*(BCLIP-TCLIP)+TCLIP
BTLIP(I)=-0
IF(I.EQ.0) GOTO 64
LIP=IFIX(HILOLD)
IF(IFIX(HIL).EQ.LIP) GOTO 64
BTLIP(I-1)=LIP
BTLIP(I) = LIP
64 CONTINUE
CALL TVIN
CALL HISTO
TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
68 FORMAT(' IS THIS ACCEPTABLE ?'/)
69 TYPE 68
ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 71
IF(ALFAB.EQ.NO ) GOTO 30
CC TYPE 103
GOTO 69
71 LOAU=.TRUE.
75 IF(SAVU) GOTO 152
73 FORMAT(' DO YOU WANT TO SAVE THE UNPROCESSED IMAGE ?'/)
TYPE 73
83 FORMAT(A5)
93 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 173
CC IF(ALFAB.EQ.YES) GOTO 123
IF(ALFAB.EQ.NO ) GOTO 151
CC103 FORMAT(33H PLEASE ANSWER ONLY 'YES' OR 'NO'/)
CC TYPE 103
GOTO 73
CC113 FORMAT(' TYPE NUMBER OF OUTPUT DRIVE'/)
CC123 TYPE 113
133 FORMAT(I)
CC ACCEPT 133,DTA
CC183 FORMAT(1H+,I2/)
CC TYPE 183,DTA
CC IF(ADMISS(DTA)) GOTO 173
CC184 FORMAT(' THIS NUMBER IS NOT PERMISSIBLE'/' FOR DSK TAKE DRIVE -7'/
CC 1' FOR MTA0 TAKE DRIVE 8'/' FOR MTA1 TAKE DRIVE 9'/)
CC TYPE 184
CC GOTO 123
193 FORMAT(' GIVE THE FILE A NAME'/)
173 TYPE 193
ACCEPT 83,FILE
CC TYPE 253,FILE
CALL DECDMP
SAVU=.TRUE.
GOTO 158
151 SAVU=.TRUE.
152 IF(NOPR) GOTO 340
188 FORMAT(' DO YOU WANT TO PROCESS THE IMAGE ?'/)
TYPE 188
198 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 203
IF(ALFAB.EQ.NO ) GOTO 307
CC TYPE 103
GOTO 188
158 IF(NOLU) GOTO 308
156 FORMAT(' DO YOU WANT TO LOAD AN UNPROCESSED IMAGE ?'/)
TYPE 156
160 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 205
CC IF(ALFAB.EQ.YES) GOTO 165
IF(ALFAB.EQ.NO ) GOTO 304
CC TYPE 103
GOTO 156
CC164 FORMAT(' TYPE NUMBER OF INPUT DRIVE'/)
CC165 TYPE 164
CC174 ACCEPT 133,DTA
CC TYPE 183,DTA
CC IF(ADMISS(DTA)) GOTO 205
CC TYPE 165
CC GOTO 174
204 FORMAT(' TYPE THE FILE NAME'/)
205 TYPE 204
ACCEPT 83,FILE
CC TYPE 253,FILE
CALL DECINP
LOAU=.TRUE.
SAVU=.FALSE.
NOPR=.FALSE.
GOTO 75
203 CALL SCAHEX
SAVP=.FALSE.
NOLU=.FALSE.
PLAY=.TRUE.
202 FORMAT(' NEWEND=',I4/)
TYPE 202,NEWEND
199 LOAP=.TRUE.
209 CONTINUE
210 IF(.NOT.LOAP) GOTO 1
218 CONTINUE
219 IF(SAVP) GOTO 235
IF(.NOT.LOAP) GOTO 1
213 FORMAT(' DO YOU WANT TO SAVE THE PROCESSED IMAGE ?'/)
TYPE 213
223 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 243
IF(ALFAB.EQ.NO ) GOTO 235
CC TYPE 103
GOTO 213
CC233 TYPE 113
CC ACCEPT 133,DTA
CC TYPE 183,DTA
CC IF(ADMISS(DTA)) GOTO 243
CC TYPE 184
CC GOTO 233
243 TYPE 193
ACCEPT 83,FILE
253 FORMAT(1H+,A5/)
CC TYPE 253,FILE
CC TAPE=8+DTA
FILEN=6*(NEWEND+1)
CALL ZERPP
CALL OFILE(TAPE,FILE)
WRITE(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
1 ((LIST(I,N),I=1,6),N=1,NEWEND)
END FILE TAPE
SAVP=.TRUE.
NOLP=.FALSE.
IF(LOAU) GOTO 75
235 IF(.NOT.LOAP) GOTO 1
CC230 FORMAT(' DO YOU WANT TO PLOT THE IMAGE ?'/)
CC TYPE 230
CC240 ACCEPT 83,ALFAB
CC IF(ALFAB.EQ.YES) GOTO 250
CC IF(ALFAB.EQ.NO ) GOTO 260
CCCC TYPE 103
CC GOTO 240
CC250 CONTINUE
252 CALL PLOU
SHOW=.TRUE.
LOAP=.FALSE.
NOPR=.FALSE.
PLAY=.TRUE.
SAVP=.TRUE.
NOLP=.FALSE.
GOTO 260
304 NOLU=.TRUE.
305 IF(LOAU) GOTO 152
300 FORMAT(' DO YOU WANT TO LOAD A PROCESSED IMAGE ?'/)
GOTO 306
307 NOPR=.TRUE.
306 IF(PLAY) GOTO 235
308 IF(NOLP) GOTO 260
TYPE 300
310 ACCEPT 83,ALFAB
IF(ALFAB.EQ.YES) GOTO 320
IF(ALFAB.EQ.NO ) GOTO 338
CC TYPE 103
GOTO 308
320 NAME=.TRUE.
CC TYPE 164
CC ACCEPT 133,DTA
CC TYPE 183,DTA
CC IF(ADMISS(DTA)) GOTO 330
CC TYPE 184
CC GOTO 320
330 TYPE 204
ACCEPT 83,FILE
CC TYPE 253,FILE
DO 335 I=1,6000
335 LIST(I,1)=0.
CC TAPE=8+DTA
CC CALL ZERPP
REWIND TAPE
CALL IFILE(TAPE,FILE)
READ(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
1 ((LIST(I,N),I=1,6),N=1,NEWEND)
TYPE 202,NEWEND
SHOW=.FALSE.
LOAP=.TRUE.
PLAY=.TRUE.
NOLP=.FALSE.
SAVP=.FALSE.
GOTO 199
338 IF(NOLP.AND.LOAU.AND.SAVU.AND.NOPR) GOTO 261
NOLP=.TRUE.
340 IF(.NOT.LOAP) GOTO 260
IF(PLAY) GOTO 260
339 FORMAT(' AN IMAGE WAS LOADED WITH THE PROGRAM'//)
TYPE 339
PLAY=.TRUE.
LOAP=.TRUE.
GOTO 210
341 IF(NOLP) GOTO 261
GOTO 308
260 IF(SAVU.AND.NOPR.AND.(.NOT.LOAP).AND.LOAU) GOTO 341
IF(LOAU) GOTO 75
261 CALL TIMER(TIM2)
TIM3=FLOAT(TIM2-TIM1)/60000.
163 FORMAT(' THIS RUN CONSUMED ',F5.3,' MINUTES OF COMPUTING TIME'/)
TYPE 163,TIM3
END